Anonymous avatar Anonymous committed fb8be74

Add implementations of Aubergine and Combinatory Logic.

Comments (0)

Files changed (2)

haskell/Aubergine.hs

+-- Interpreter for Aubergine http://esolangs.org/wiki/Aubergine/aubergine.hs
+-- does not handle input at all
+
+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
+
+-- Evaluator for Combinatory Logic (SKI-calculus)
+-- I am not entirely convinced that it is correct
+
+data Term = S
+          | K
+          | I
+          | Pair Term Term
+    deriving (Ord, Show, Eq)
+
+
+step S = S
+step K = K
+step I = I
+step (Pair I x) = x
+step (Pair (Pair K x) y) = x
+step (Pair (Pair (Pair S x) y) z) = (Pair (Pair x z) (Pair y z))
+step (Pair l r) = (Pair (eval l) (eval r))
+
+eval term =
+    let
+        term' = step term
+    in
+        if term == term' then
+            term
+        else
+            eval term'
+
+parseChar 'S' = S
+parseChar 'K' = K
+parseChar 'I' = I
+
+kParse (' ':rest) =
+    kParse rest
+kParse ('(':rest) =
+    let
+        (t, rest') = kParse rest
+    in
+        bParse rest' t
+kParse (char:rest) =
+    bParse rest (parseChar char)
+
+bParse [] acc =
+    (acc, [])
+bParse (' ':rest) acc =
+    bParse rest acc
+bParse (')':rest) acc =
+    (acc, rest)
+bParse ('(':rest) acc =
+    let
+        (t, rest') = kParse rest
+    in
+        bParse rest' (Pair acc t)
+bParse (char:rest) acc =
+    bParse rest $ Pair acc (parseChar char)
+
+
+run x = eval $ fst $ kParse x
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.