Skip to main content
fix formatting
Source Link
Zeta
  • 19.3k
  • 2
  • 55
  • 89
forward  :: Tape -> Tape
backward :: Tape -> Tape
modify   :: (Word8 -> Word8) -> Tape -> Tape
value    :: Tape -> Word8

Now that we have the data types out of the way: it's good that you have some type signatures, but it's a shame that you left them at some point. And the use of unsafeCoerce is really unsafe there. A Char does not consists of a single byte, a Char is a unicode character. You can use fromIntegral . fromEnum, although you still want to handle those cases where the character value exceeds 255.

So we now have a Program, a Tape and all of that. Those are alternative solutions. So, why do I even propose them? Because they make your other functions easier. Let us have a look at pu:

pu :: State -> Input -> (State, Output)
pu state@(State memL memR@((MemCell cell):tMemR) (Position pos)) (instruc, inpt) = (state', (out, cmd))
  where state' = State memL' memR' (Position pos')
        pos' = 0  -- Dummy

        memR' | instruc == incB = (MemCell (cell + 1)) : tMemR
              | instruc == decB = (MemCell (cell - 1)) : tMemR
              | instruc == rd = (MemCell inpt) : tMemR
              | instruc == incP = tMemR
              | instruc == decP = (head memL) : memR
              | otherwise = memR

        memL' | instruc == incP = (MemCell cell) : memL
              | instruc == decP = tail memL
              | otherwise = memL

        out | instruc == prnt = Just (chr . fromIntegral $ cell)
            | otherwise = Nothing

        cmd | instruc == moveR = Jump R
            | instruc == moveL = Jump L
            | otherwise = Continue

There's a lot going on there. Now, if we use our Tape and BFInstruction, the code gets tremendously easier:

pu :: BFInstruction -> Tape -> String -> (String, String, Tape)
pu i t input = 
  case i of
    BFInc    -> taped $ modify (+1) t
    BFDec    -> taped $ modify (subtract 1) t
    BFPrev   -> taped $ backward t
    BFNext   -> taped $ forward t
    BFGet    -> ("", tail input, modify (const (head input)) tape) -- type error here, but easy to fix
    BFPut    -> (value tape, input, tape) -- type error, easy to fix
    BFLoop p | value t /= 0 -> runLoop p
    _        -> taped t

 where 
   taped t' = ("", input, t') -- no output, no input consumption

Instead of guards with ==, you now compare to data constructors. This has the nice side-effect that the compiler can now warn you if you forgot an instruction. And all just because we went from String to [BFInstruction]. We eliminated a bunch of mistakes that can happen there. Note that I left runLoop out since it is a little bit difficult to write with those types; it's a lot easier if we used another data type. But it's possible with (String, String, Tape).

forward  :: Tape -> Tape
backward :: Tape -> Tape
modify   :: (Word8 -> Word8) -> Tape -> Tape

Now that we have the data types out of the way: it's good that you have some type signatures, but it's a shame that you left them at some point. And the use of unsafeCoerce is really unsafe there. A Char does not consists of a single byte, a Char is a unicode character. You can use fromIntegral . fromEnum, although you still want to handle those cases where the character value exceeds 255.

forward  :: Tape -> Tape
backward :: Tape -> Tape
modify   :: (Word8 -> Word8) -> Tape -> Tape
value    :: Tape -> Word8

Now that we have the data types out of the way: it's good that you have some type signatures, but it's a shame that you left them at some point. And the use of unsafeCoerce is really unsafe there. A Char does not consists of a single byte, a Char is a unicode character. You can use fromIntegral . fromEnum, although you still want to handle those cases where the character value exceeds 255.

So we now have a Program, a Tape and all of that. Those are alternative solutions. So, why do I even propose them? Because they make your other functions easier. Let us have a look at pu:

pu :: State -> Input -> (State, Output)
pu state@(State memL memR@((MemCell cell):tMemR) (Position pos)) (instruc, inpt) = (state', (out, cmd))
  where state' = State memL' memR' (Position pos')
        pos' = 0  -- Dummy

        memR' | instruc == incB = (MemCell (cell + 1)) : tMemR
              | instruc == decB = (MemCell (cell - 1)) : tMemR
              | instruc == rd = (MemCell inpt) : tMemR
              | instruc == incP = tMemR
              | instruc == decP = (head memL) : memR
              | otherwise = memR

        memL' | instruc == incP = (MemCell cell) : memL
              | instruc == decP = tail memL
              | otherwise = memL

        out | instruc == prnt = Just (chr . fromIntegral $ cell)
            | otherwise = Nothing

        cmd | instruc == moveR = Jump R
            | instruc == moveL = Jump L
            | otherwise = Continue

There's a lot going on there. Now, if we use our Tape and BFInstruction, the code gets tremendously easier:

pu :: BFInstruction -> Tape -> String -> (String, String, Tape)
pu i t input = 
  case i of
    BFInc    -> taped $ modify (+1) t
    BFDec    -> taped $ modify (subtract 1) t
    BFPrev   -> taped $ backward t
    BFNext   -> taped $ forward t
    BFGet    -> ("", tail input, modify (const (head input)) tape) -- type error here, but easy to fix
    BFPut    -> (value tape, input, tape) -- type error, easy to fix
    BFLoop p | value t /= 0 -> runLoop p
    _        -> taped t

 where 
   taped t' = ("", input, t') -- no output, no input consumption

Instead of guards with ==, you now compare to data constructors. This has the nice side-effect that the compiler can now warn you if you forgot an instruction. And all just because we went from String to [BFInstruction]. We eliminated a bunch of mistakes that can happen there. Note that I left runLoop out since it is a little bit difficult to write with those types; it's a lot easier if we used another data type. But it's possible with (String, String, Tape).

fix formatting
Source Link
Zeta
  • 19.3k
  • 2
  • 55
  • 89
parse []     = Right []
parse (x:xs) = 
  case x of
    '>' -> BFNext <$:> parse xs
    '<' -> BFPrev <$:> parse xs
    '+' -> BFInc  <$:> parse xs
    '-' -> BFDec  <$:> parse xs
    '.' -> BFPut  <$:> parse xs
    ',' -> BFGet  <$:> parse xs
    '[' -> handleLoop xs         -- left as exercise
    ']' -> Left "Unexpected ']'" -- ']' should get handled by handleLoop
    _   -> parse xs 

-- I'm too lazy to use `fmap` above all the time. Remember, we 
-- return `Right` or `Left` in `parse` therefore we cannot simply
-- use (:) to map our values
x <$:> xs = fmap (x:) xs

-- I'm too lazy to use fmap above all the time. Remember, we -- return Right or Left in parse therefore we cannot simply -- use (:) to map our values x <$:> xs = fmap (x:) xs You You can heavily improve the parser if you add line and column numbers to the parser error, but that's for another time.

parse []     = Right []
parse (x:xs) = 
  case x of
    '>' -> BFNext <$:> parse xs
    '<' -> BFPrev <$:> parse xs
    '+' -> BFInc  <$:> parse xs
    '-' -> BFDec  <$:> parse xs
    '.' -> BFPut  <$:> parse xs
    ',' -> BFGet  <$:> parse xs
    '[' -> handleLoop xs         -- left as exercise
    ']' -> Left "Unexpected ']'" -- ']' should get handled by handleLoop
    _   -> parse xs

-- I'm too lazy to use fmap above all the time. Remember, we -- return Right or Left in parse therefore we cannot simply -- use (:) to map our values x <$:> xs = fmap (x:) xs You can heavily improve the parser if you add line and column numbers to the parser error, but that's for another time.

parse []     = Right []
parse (x:xs) = 
  case x of
    '>' -> BFNext <$:> parse xs
    '<' -> BFPrev <$:> parse xs
    '+' -> BFInc  <$:> parse xs
    '-' -> BFDec  <$:> parse xs
    '.' -> BFPut  <$:> parse xs
    ',' -> BFGet  <$:> parse xs
    '[' -> handleLoop xs         -- left as exercise
    ']' -> Left "Unexpected ']'" -- ']' should get handled by handleLoop
    _   -> parse xs 

-- I'm too lazy to use `fmap` above all the time. Remember, we 
-- return `Right` or `Left` in `parse` therefore we cannot simply
-- use (:) to map our values
x <$:> xs = fmap (x:) xs

You can heavily improve the parser if you add line and column numbers to the parser error, but that's for another time.

Source Link
Zeta
  • 19.3k
  • 2
  • 55
  • 89

When you compile a language, you usually split the input into tokens with a lexer, then parse those tokens with a parser into syntactic elements in an abstract syntax tree (AST) and then use that to optimize the program and finally generate machine code.

With Brainfuck, none of this is really necessary, but it makes your code much easier to understand, especially the AST. The biggest problem in my point of view is that you don't actually have a program at the end. Your parse results in a Vector Char and a jump map, which by the way is not complete. Try the (malformed) programs ,[[.,] or ,[.,]]. The latter will result in a "head called on empty list" error, the first will silently ignore the [ during parse but will crash during interpretation.

The latter error is too late. It should have been found during the parsing step. However, this is a lot easier if you use a new datatype:

type Program = [BFInstruction]

-- Can be also used as a toy for Free, but that's a little bit too much.
-- But if you come back to this code in some months, have a look at
-- "Free monads" and the "free" package for some fun.
-- In some months, mind you!
data BFInstruction = BFNext | BFPrev   -- memory movements
                   | BFInc  | BFDec    -- increment / decrement
                   | BFPut  | BFGet    -- to stdout / from stdin
                   | BFLoop Program    -- loops

If you parse your program into a Program, there's no way you can accidentally end up with a superfluous [, since your type does not allow that. That's a big promise, so I repeat it: if we have a Program, we can be certain that it's well-formed.

By the way, your f in parse can be heavily simplified:

instrucs = filter f $ s
  where
    f x = x `elem` [incP, decP, incB, decB, prnt, rd, moveR, moveL]

Either way, back to parsing. I suggest you to write parse :: String -> Either String Program. In any ASCII text, there can be only two parser errors:

  • unexpected ], e.g. ]->
  • unclosed [, e.g. [++

Now, parse will probably get a little bit harder, but not too much:

parse []     = Right []
parse (x:xs) = 
  case x of
    '>' -> BFNext <$:> parse xs
    '<' -> BFPrev <$:> parse xs
    '+' -> BFInc  <$:> parse xs
    '-' -> BFDec  <$:> parse xs
    '.' -> BFPut  <$:> parse xs
    ',' -> BFGet  <$:> parse xs
    '[' -> handleLoop xs         -- left as exercise
    ']' -> Left "Unexpected ']'" -- ']' should get handled by handleLoop
    _   -> parse xs

-- I'm too lazy to use fmap above all the time. Remember, we -- return Right or Left in parse therefore we cannot simply -- use (:) to map our values x <$:> xs = fmap (x:) xs You can heavily improve the parser if you add line and column numbers to the parser error, but that's for another time.

For memory, I suggest you to use a separate data type for the whole memory, not for the parts left and right of the current cursor. Something like

data Tape = Tape [Word8] Word8 [Word8]

comes in mind. You can still use the same logic as above, but now the (possibly infinite) tape can get tested without running an actual brainfuck program. As an exercise, write

forward  :: Tape -> Tape
backward :: Tape -> Tape
modify   :: (Word8 -> Word8) -> Tape -> Tape

If you follow that approach, you don't need a JumpMap anymore, nor will you need your State (it has been replaced by Tape).

Now that we have the data types out of the way: it's good that you have some type signatures, but it's a shame that you left them at some point. And the use of unsafeCoerce is really unsafe there. A Char does not consists of a single byte, a Char is a unicode character. You can use fromIntegral . fromEnum, although you still want to handle those cases where the character value exceeds 255.