Aubergine/aubergine.hs

This is an implementation of Aubergine in Haskell by Chris Pressey. It is imperfect:

• It does not handle input at all.
• Attempts to access beyond the bounds of the program crash the interpreter. So, the quine example runs, but hits an exception at the very end. Actually, the reference interpreter does this too, and the article doesn't say what should happen in this case, so it's probably OK.
• It is written in an amateurish Haskell style.

However:

• It uses Haskell's Integer data type to simulate unbounded integers.
• I might improve it at some point.

import qualified Data.Char as Char

--                 a       b       i       program
data State = State Integer Integer Integer [Integer]
     deriving (Ord, Eq, Show)

getAt 0 (head:_)    = head
getAt n (head:tail) = getAt (n-1) tail

getCharAt n l = Char.chr $ fromIntegral $ getAt n l

setAt 0 v (_:tail)    = v:tail
setAt n v (head:tail) = head:setAt (n-1) v tail

getCmd (State _ _ i p) =
    (getCharAt i p, getCharAt (i+1) p, getCharAt (i+2) p)

get '1' _               = 1
get 'a' (State a _ _ _) = a
get 'b' (State _ b _ _) = b
get 'i' (State _ _ i _) = i
get 'A' (State a _ _ p) = getAt a p
get 'B' (State _ b _ p) = getAt b p

set 'a' a (State _ b i p) = State a b i p
set 'b' b (State a _ i p) = State a b i p
set 'i' i (State a b _ p) = State a b i p
set 'A' x (State a b i p) = State a b i $ setAt a x p
set 'B' x (State a b i p) = State a b i $ setAt b x p

advance (State a b i p) = State a b (i+3) p

step :: State -> IO State
step s@(State a b i p) = do
    s' <- case getCmd s of
        ('=', 'o', src) -> do
            putChar $ Char.chr $ fromIntegral $ get src s
            return s
        ('=', dest, src) -> do
            return $ set dest (get src s) s
        ('+', dest, src) -> do
            return $ set dest (get dest s + get src s) s
        ('-', dest, src) -> do
            return $ set dest (get dest s - get src s) s
        (':', dest, src) ->
            case get src s of
                0 -> do return s
                _ -> do return $ State a b (get dest s) p
    return $ advance s'

run :: State -> IO State
run s = do
    s'@(State _ _ i p) <- step s
    let size = fromIntegral $ length p
    if i >= size then return s' else run s'

parse string =
    State 0 0 0 $ map (fromIntegral . Char.ord) string

runString string = run $ parse string