3
\$\begingroup\$

This is an interpreter that takes in a slightly altered Befunge-93 (no input from the user, no limits on size and division by zero defaults to zero).

I'm currently looking at the state monad and how it could be integrated into what I wrote. It seems to change quite a bit in the way I have to think about my interpreter so it might take a while.

Are there any other improvements I could bring to it?

{-# LANGUAGE TemplateHaskell #-}
module Befunge93 where
import System.Random
import Control.Lens
import Data.Char
import Data.List as L
import Data.Sequence as S (fromList, update, index, length, Seq)
import Data.Foldable (toList)

data InterpState = InterpState {
  _program :: S.Seq (S.Seq Char),
  _stack :: [Int],
  _location :: (Int, Int),
  _direction :: (Int, Int),
  _output :: String,
  _rand :: StdGen,
  _stringMode :: Bool
}
$(makeLenses ''InterpState)

safePop :: [Int] -> (Int, [Int])
safePop [] = (0, [])
safePop (h:t) = (h, t)

safePopN :: Int -> [Int] -> ([Int], [Int])
safePopN n stack = (taken ++ zeroPadding, drop n stack)
  where taken = take n stack
        zeroPadding = replicate (n - L.length taken) 0

wrapIfNeeded :: Int -> (Int, Int) -> Int
wrapIfNeeded val (intStart, intEnd)
  | val < intStart = intEnd
  | val > intEnd = intStart
  | otherwise = val

takeStep :: InterpState -> InterpState
takeStep interp = set location newLocation interp
  where (locX, locY) = view location interp
        (dirX, dirY) = view direction interp
        (matX, matY) = (S.length prog, S.length $ S.index prog locX)
        (stepX, stepY) = (locX + dirX, locY + dirY)
        newLocation = (wrapIfNeeded stepX (0, matX - 1), wrapIfNeeded stepY (0, matY - 1))
        prog = view program interp

evalInstr :: Char -> InterpState -> InterpState
evalInstr '#' interp = takeStep interp
evalInstr ' ' interp = interp
evalInstr '<' interp = set direction (0, -1) interp
evalInstr '>' interp = set direction (0, 1) interp
evalInstr '^' interp = set direction (-1, 0) interp
evalInstr 'v' interp = set direction (1, 0) interp

evalInstr ':' interp = set stack (popped:(popped:rest)) interp
  where (popped, rest) = safePop $ view stack interp

evalInstr '_' interp = set stack rest . set direction newDirection $ interp
  where (popped, rest) = safePop $ view stack interp
        newDirection = if popped == 0 then (0, 1) else (0, -1)

evalInstr '|' interp = set stack rest . set direction newDirection $ interp
  where (popped, rest) = safePop $ view stack interp
        newDirection = if popped == 0 then (1, 0) else (-1, 0)

evalInstr '$' interp = set stack rest interp
  where (_, rest) = safePop $ view stack interp

evalInstr '!' interp = set stack (newValue:rest) interp
  where (popped, rest) = safePop $ view stack interp
        newValue = if popped == 0 then 1 else 0

evalInstr '`' interp = set stack (newValue:rest) interp
  where (popped, rest) = safePopN 2 $ view stack interp
        (a, b) = (head popped, popped !! 1)
        newValue = if b > a then 1 else 0

evalInstr '\\' interp = set stack (b:(a:rest)) interp
  where (popped, rest) = safePopN 2 $ view stack interp
        (a, b) = (head popped, popped !! 1)

evalInstr 'p' interp = set stack rest . set program newProgram $ interp
  where (popped, rest) = safePopN 3 $ view stack interp
        (a, b, c) = (head popped, popped !! 1, popped !! 2)
        prg = view program interp
        newProgram = S.update a newSubseq prg
        newSubseq = S.update b (chr c) (prg `S.index` a)

evalInstr 'g' interp = set stack (result:rest) interp
  where (popped, rest) = safePopN 2 $ view stack interp
        (a, b) = (head popped, popped !! 1)
        prg = view program interp
        result = ord $ (prg `S.index` a) `S.index` b

evalInstr '?' interp = set rand newRand . set direction randomDirection $ interp
  where (randVal, newRand) = randomR (0, 3) (view rand interp) :: (Int, StdGen)
        randomDirection = case randVal of 0 -> (0, 1)
                                          1 -> (0, -1)
                                          2 -> (1, 0)
                                          3 -> (-1, 0)

evalInstr ch interp
  | ch `L.elem` ("+-*/%" :: String) = set stack (result:rest) interp
  where (popped, rest) = safePopN 2 $ view stack interp
        (a, b) = (head popped, popped !! 1)
        result = case ch of '+' -> b + a
                            '-' -> b - a
                            '*' -> b * a
                            '/' -> if a == 0 then 0 else b `div` a
                            '%' -> if a == 0 then 0 else b `mod` a

evalInstr ch interp
   | ch `L.elem` (".," :: String) = set stack rest . set output newOutput $ interp
   where (popped, rest) = safePop $ view stack interp
         newOutput = view output interp ++ outputValue
         outputValue = if ch == '.' then show popped else [chr popped]

evalChar :: Char -> InterpState -> InterpState
evalChar currentChar state
  | inStringMode && currentChar == '"' = takeStep $ set stringMode False state
  | currentChar == '"' = takeStep $ set stringMode True state
  | inStringMode = takeStep $ set stack (ord currentChar:view stack state) state
  | isDigit currentChar = takeStep $ set stack (read [currentChar]:view stack state) state
  | otherwise = takeStep $ evalInstr currentChar state
  where inStringMode = view stringMode state

evalProgram :: InterpState -> String
evalProgram state
  | currentChar == '@' && not inStringMode = view output state
  | otherwise = evalProgram $ evalChar currentChar state
  where currentChar = S.index (S.index prog locX) locY
        (locX, locY) = view location state
        prog = view program state
        inStringMode = view stringMode state

interpret :: StdGen -> String -> String
interpret rand s = evalProgram $ InterpState programAsSequence [] (0, 0) (0, 1) "" rand False
  where programAsSequence = S.fromList $ map S.fromList (lines s)
\$\endgroup\$
1
\$\begingroup\$

_program :: S.Seq (S.Seq Char),

I could be wrong, but I think a Befunge program is a fixed-size 2-d array. In any case you want to decide how you want to handle the following issues:

  • what to return for out of bounds gets
  • what happens on an out of bounds put - does the grid expand? what opcodes are new spaces populated with?

As it stands, the program 99g will throw an exception.

If you decide not to expand the grid, then consider using Data.Array for the program. Using an array will give you the additional assurance that all rows have the same length.

_rand :: StdGen,

You only use this to generate random numbers in [0..3], so I would consider using the type [Int] for this field. This makes your code a lot easier to test since then you can populate this field with a known sequence of random values.

To "use up" a random value, just pop one off the head of the list and

getRandom :: Interp -> (a, Interp) getRandom state = let (a:as) = view rands state state' = set rands as state in (a,state')

Use randomRs to create a infinite list of random values, e.g.:

randomRs stdgen (0,3)

where stdgen is a StdGen value.

wrapIfNeeded

Just use mod - mod a n will always return a value in the range 0..n-1 when n is positive.

(0,1), (1,0), (0,-1), (-1,0)

Since you use these values more than once, create names for them, e.g.:

up = (-1,0)
down = (1,0)
...

invalid instructions

Your code will thrown an exception if it encounters a character which is not a Befunge opcode. If this is the behavior you want, you should make it explicit with an otherwise clause:

evalInstr ch interp
  | ch `L.elem` ("+-*/%" :: String) = set stack (result:rest) interp
  | otherwise = error "bad opcode"

... !! 1

This code:

 where (popped, rest) = safePopN 2 $ view stack interp
       (a, b) = (head popped, popped !! 1)

may be written:

 where ( (a:b:_), rest) = safePopN 2 $ ...

and similarly for popping 3 numbers, i.e replace:

where (popped, rest) = safePopN 3 $ view stack interp
      (a, b, c) = (head popped, popped !! 1, popped !! 2)

with

where ( (a:b:c:_) , rest ) = safePopN 3 $ ...

That said, I would write separate pop{1,2,3} functions:

pop1 :: Interp -> (Int, Interp)
pop2 :: Interp -> (Int, Int, Interp)
pop3 :: Interp -> (Int, Int, Int, Interp)

The problem is that the pattern matching (or the !! operations) can fail at runtime. But if you use the pop{1,2,3} functions the compiler can check at compile time that you are assigning to the correct number of variables.

Also, you can hide all of the details of updating the stack in just one function - right now it is duplicated across safePop, safePopN and the functions which call them. For instance, once you have defined pop1, here's how you can define pop2 and pop3:

pop2 state = let (a,state') = pop1 state
                 (b,state'') = pop1 state
             in (a,b,state'')

pop3 state = let (a,b,state') = pop2 state
                 (c,state'')  = pop1 state
             in (a,b,c,state'')

Now all of the details of updating the state for a pop are encapsulated in just one function - pop1 and the functions which call the pop functions don't have to know about how to update that part of the state.

Testing

You should provide functions which make it easy to test the interpreter. In particular, I would provide functions which:

  • Provide a Show instance for Interp
  • Create an Interp from a grid, initial position, direction, random numbers (either a StdGen or [Int] as I have suggested) and defaulting all the other values.
  • Step an interpreter one instruction

I.e.:

mkInterp :: [String] -> (Int,Int) -> (Int,Int) -> {rand} -> Interp
step :: Interp -> Interp

With a step function it becomes easy to trace execution. Here is code to print 10 steps of execution:

let state = mkInterp ...

mapM_ print (take 10 $ iterate step state)
\$\endgroup\$
  • \$\begingroup\$ They're not exactly 2D arrays; the line length can vary and padding with no-ops can lead to different behavior in some cases, for example if you're in string mode no-ops push ord ' ' on the stack. I chose sequences so that I can update values at specific indexes more easily. Thanks for the review! I'll read it more carefully today. I especially like part with the lazy randoms. \$\endgroup\$ – user29120 Oct 20 '15 at 7:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy