git @ Cat's Eye Technologies Dipple / master haskell / Aubergine.hs
master

Tree @master (Download .tar.gz)

Aubergine.hs @masterraw · history · blame

-- Interpreter for Aubergine http://esolangs.org/wiki/Aubergine/aubergine.hs
-- does not handle input at all

-- SPDX-FileCopyrightText: Chris Pressey, the original author of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- SPDX-License-Identifier: Unlicense

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