$> cabal install Befunge93

If you want to read about how I designed it you can check out the source above, or take a look at my previous blog post.

Please report any bugs to me, and I’m also very interested in patches or suggestions for performance improvements if anyone ends up being interested in this program.

EDIT: Here is the package page: http://hackage.haskell.org/package/Befunge93

Design

I found that writing the core functionality of the interpreter took almost no time, once I settled on the approach I would take. I used a monad transformer for the first time, StateT:

type REPL a = StateT ProgramState IO a

This let me pass around the state of the computation in the State monad while doing IO actions. This made some potentially-awkward befunge commands really easy to implement.

Here is an excerpt from the function execute :: Char -> REPL () which reads the befunge character at our position and returns the code to execute:

         -- Pop value and output as an integer. funge-98 spec calls for
         -- integer to be followed by a space, so we'll do that too:
         '.' -> do i <- pop
                   liftIO $ putStr $ show i ++" "
        
         -- Pop value and output as ASCII character
         ',' -> do i <- pop
                   liftIO $ putChar $ chr i

         '\\' -> do (a,b) <- pop2
                    push a
                    push b
        
         ':' -> do a <- pop
                   replicateM_ 2 (push a)
        
    -- program flow commands: --
         ' ' -> return ()    

         '>' -> setDirection right
        
         '<' -> setDirection left  
      
         '^' -> setDirection up
      
         'v' -> setDirection down
        
         '?' -> getRandomDirection >>= setDirection 

And here is the program state that gets passed in the monad:

data ProgramState = 
    ES { -- state of the code and stack:
         code :: Code,    
         stack :: Stack,
         -- state of program flow:
         position :: Position, 
         direction :: Direction,
         haltBit :: Bool,
         -- random generator:
         randGen :: StdGen, 
         -- errors or other messages we collect:
         messages :: [String],
         -- should we announce messages and warnings?:
         verbose :: Bool
        } 

I only use the accessor functions (as opposed to pattern matching) to reach into the state in my code, so it was easy to add another state parameter if I wanted to extend the functionality somewhere.

Finally here is the evaluation loop that ties the core of the interpreter together:

evalLoop :: REPL ()
evalLoop = do
     -- extract the command at our position & execute it:
    getCmd >>= execute
     -- print messages in the queue (unless quiet), and clear it:
    printMessages
     -- halt if @ command issued, else move and recurse:
    halting <- gets haltBit
    unless halting (move >> evalLoop) 

I found the most time-consuming parts of this project were in the design decisions and behaviour tweaks related to holes in the ‘93 spec, and tracking down a few silly bugs that came from wrong assumptions about the spec.

Vital in debugging were the CCBI interpreter as well as the pyfunge interpreter. It’s difficult to debug an interpreter when you don’t whether the befunge code you are testing on is buggy or whether your interpreter is!

One last detail that I am proud of is the test suite that I have integrated into my darcs repo. Darcs automatically runs the befunge-93 portion of the amazing mycology test suite by Matti Niemenmaa on each commit, as well as two smaller test befunge programs from phlamethrower, testing that the interpreter hasn’t changed behavior.

Play With It

You can check out the full source for the program here, or get my whole darcs repository with:

$ darcs get --tag=v0.2 http://coder.bsimmons.name/code/Befunge

And here are a few nice programs to try out, written by folks cleverer than I, and stolen from vsync’s funge stuff here.

aturley.bf by Andrew Turley:

>84*>:#v_55+"ude.ub@yelruta">:#,_@>188*+>\02p\12p\:22p#v_$    55+,1-         v
    ^  0 v +1\                   _^#-+*<>22g02g*"_@"*-!1- #v_v>
       >:>::3g: ,\188                  ^^               -1\g21\g22

life.bf by Dmitry M Litvinov:

v>>31g> ::51gg:2v++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9p BXY|-+98 *7^>+\-0|< + *                                                     *    +
*5 ^:+ 1pg15\,:< + *                                                     ***  +
10^  <>$25*,51g1v+                                                            +
-^ p< | -*46p15:+<+                                                            +
> 31^> 151p>92*4v+                                                            +
 ^_ ".",   ^ vp1< +                                                            +
>v >41p      >0 v+                                                            +
:5! vg-1g15-1g14< +                                                            +
+1-+>+41g1-51gg+v+                                                            +
1p-1vg+1g15-1g14< +                                                            +
g61g>+41g51g1-g+v+                                                            +
14*1v4+g+1g15g14< +                           * *                              +
5>^4>1g1+51g1-g+v+                           * *                              +
^ _^v4+gg15+1g14< +                           ***                              +
>v! >1g1+51g1+g+v+                                                            +
g8-v14/*25-*4*88< +                                                            +
19+>g51gg" "- v  +                                                            +
4*5  v< v-2:_3v+                                                            +
 >^   |!-3_$  v< -+                                                            +
^    < <      <|<+                                                         ***+
>g51gp ^ >51gp^>v+                                                            +
^14"+"< ^g14"!"<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

prime.bf by Kalyna Zazelenchuk:

222p35*89+*11p>133p                   >33g1+33p   22g33g- v>22g33g%#v_v
 o                                                        >|
  2                             v,,,,, ,,,,,.g22"is prime."< 1                            >    v^                             < ^_@#-g11g22p22+1g22,*25<,,,,,,,,,,,,,.g22"is not prime."<

There is still a lot that could be done, but I think I’m done with it for now. Thanks for looking!

To adapt the module to a problem, one defines the following:

1. a type Case into which we will parse a test case (i.e. problem)
2. a type SolvedCase, representing a solution to a test case
3. our algorithm :: Case -> SolvedCase
4. a Parser caseParser which can parse a single test case (n.b. not the whole file) into the Case type
5. a function formatCase :: SolvedCase -> String which brings the solution to the state where it can be prepended with the standard “Case #1: ” string

Here is the module, filled in to solve the Minimum Scalar Product practice problem. You can download the code here:

module Main
    where

import Text.ParserCombinators.Parsec
import IO hiding (try)
import System.Environment

-- PROBLEM-SPECIFIC IMPORTS --
import Data.List (sort)
import Control.Arrow
------------------------------


-- the input file will be parsed into a list of some type representing
-- individual cases to be solved by our algorithm:
type Input = [Case] 

-- our algorithms will produce a list of some type SolutionCase:
type Solution = [SolvedCase] 

-- we convert each solved case into a String, which is zipped with
--  the standard "Case #x: " strings for the final output
type Output = [String]





-- --------------- BEGIN EDITING --------------- --



-- DEFINE A TYPE TO REPRESENT A SINGLE UNSOLVED TEST CASE: --
type Case =
    -- EXAMPLE: a pair of lists of Ints (our "vectors"):
    ([Int],[Int])


-- DEFINE A TYPE TO REPRESENT A SINGLE SOLVED TEST CASE: --
type SolvedCase = 
    -- EXAMPLE: our Minimum Scalar Product as an Int:
    Int


     -- -- -- ALGORITHMS -- -- --


-- SOLVE A TEST CASE HERE:
algorithm :: Case -> SolvedCase
algorithm = 
    -- EXAMPLE: simply sort both lists, reverse one, and combine:
    sum . uncurry (zipWith (*)) . (reverse . sort *** sort)



    -- -- -- PARSING INPUT -- -- --


-- DEFINE PARSER FOR A TEST CASE: --
caseParser :: Parser Case
caseParser = do
     -- EXAMPLE: parses a case consisting of 3 lines: the first describes the
     --  number n of elements in the following two lines, the next two lines
     -- have n space-separated elements:
    w <- word
    let n = read w
    as <- count n word
    bs <- count n word
    return  (map read as, map read bs)



     -- -- -- FORMAT OUTPUT -- -- --


-- DEFINE A FUNCTION FROM AN INDIVIDUAL SolvedCase -> String.
formatCase :: SolvedCase -> String
formatCase sol = 
    -- EXAMPLE: nothing to speak of here:
    show sol
    
  

-- --------------- STOP EDITING --------------- --



    --------------------
    -- IO BOILERPLATE --
    --------------------


main = do
    
     -- pass the input file name to our program:
    (f:_) <- getArgs
    file  <- readFile f

     -- start parsing, solve problem, and prepare output:
    let inp  = parseWith mainParser file
        solution        = map algorithm inp
        solutionStrings = map formatCase solution
        outp = zipWith (++) prefixes solutionStrings
    
     -- write the prepared output to screen:
    putStr $ unlines outp


-- dies with error, or returns some datatype with our parsed data:
parseWith p = either (error . show) id . parse p "" 

-- to begin parsing, we read in a line containing the number of test cases
-- to follow. We parse them with caseParser, returning a list:
mainParser :: Parser Input
mainParser = do
    n  <- word
    ms <- count (read n) caseParser 
    return ms
    <?> "mainParser"

-- strings to prepend to output:
prefixes = [ "Case #" ++ show n ++ ": " | n <- [1..]]





    ---------------------
    -- VARIOUS PARSERS --
    ---------------------


-- -- LINE PARSERS -- --


-- a single line String, up to the newline:
wholeLine :: Parser String
wholeLine = manyTill anyChar (try newline) <?> "wholeLine"

-- parse a String with whitespace-separated values into [String]
whiteSepLine = manyTill spaceSepWord newline <?> "whiteSepLine"


-- -- WORD PARSERS -- --


-- a single word followed by whitespace (space, newline, etc.):
word = do
    w <- many1 nonWhite
    spaces
    return w
    <?> "word"

-- a single word followed by one or more ' ' characters (won't consume '\n')
spaceSepWord = do
    w <- many1 nonWhite
    many (char ' ')
    return w
    <?> "spaceSepWord"

-- e.g. "hello:world" ---> ("hello","world")
-- won't consume newlines
twoWordsSepBy c = do
    x <- manyTill nonWhite (try$ char c)
    y <- many1 nonWhite
    many (char ' ')
    return (x,y)
    <?> "twoWordsSepBy"


-- -- CHARACTER PARSERS -- --


-- nonWhitespace character:
nonWhite = noneOf " \v\f\t\r\n" <?> "nonWhite"

I just finished the initial release of a simple module called list-grouping that contains functions to partition a list into sub-lists in various ways, based on some predicate or integer offset. Functions like these are a little awkward to write and I was surprised when I didn’t see anything on hackage!

Check out the package description and install it with:

$ cabal install list-grouping

Here is an example from a previous post to build a binary tree from an in-order list, which uses the above library:

module Main
    where

import Data.List.Grouping

data Tree a = Node a (Tree a) (Tree a)
            | End
             deriving Show

fromSorted :: [a] -> Tree a
fromSorted = foldl mkTree End . splitWith [2^n | n<-[0..]]
    where mkTree l (n:ns) = Node n l (fromSorted ns)

I’m sure the functions can be made more efficient, to take advantage of fusion or what-not, and I hope the library will eventually contain the most efficient implementations possible.

I also am looking for suggestions for other useful list grouping functions to include. Send your suggestions along! You can get the darcs source with:

$ darcs get http://coder.bsimmons.name/code/ListGrouping/

It’s very likely there are some bugs, especially related to cross platform issues with file names and paths. The module is also fairly bare, so please send me any requests for functionality that I haven’t thought of, as well as any bugs you might find.

You can install it with:

$ cabal install directory-tree

And get the source with:

$ darcs get http://coder.bsimmons.name/code/DirectoryTree/

I hope this is useful to someone!