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  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