git @ Cat's Eye Technologies The-Dipple / 47c464d
Add implementations of Aubergine and Combinatory Logic. catseye 12 years ago
2 changed file(s) with 121 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+64
-0
haskell/Aubergine.hs less more
0 -- Interpreter for Aubergine http://esolangs.org/wiki/Aubergine/aubergine.hs
1 -- does not handle input at all
2
3 import qualified Data.Char as Char
4
5 -- a b i program
6 data State = State Integer Integer Integer [Integer]
7 deriving (Ord, Eq, Show)
8
9 getAt 0 (head:_) = head
10 getAt n (head:tail) = getAt (n-1) tail
11
12 getCharAt n l = Char.chr $ fromIntegral $ getAt n l
13
14 setAt 0 v (_:tail) = v:tail
15 setAt n v (head:tail) = head:setAt (n-1) v tail
16
17 getCmd (State _ _ i p) =
18 (getCharAt i p, getCharAt (i+1) p, getCharAt (i+2) p)
19
20 get '1' _ = 1
21 get 'a' (State a _ _ _) = a
22 get 'b' (State _ b _ _) = b
23 get 'i' (State _ _ i _) = i
24 get 'A' (State a _ _ p) = getAt a p
25 get 'B' (State _ b _ p) = getAt b p
26
27 set 'a' a (State _ b i p) = State a b i p
28 set 'b' b (State a _ i p) = State a b i p
29 set 'i' i (State a b _ p) = State a b i p
30 set 'A' x (State a b i p) = State a b i $ setAt a x p
31 set 'B' x (State a b i p) = State a b i $ setAt b x p
32
33 advance (State a b i p) = State a b (i+3) p
34
35 step :: State -> IO State
36 step s@(State a b i p) = do
37 s' <- case getCmd s of
38 ('=', 'o', src) -> do
39 putChar $ Char.chr $ fromIntegral $ get src s
40 return s
41 ('=', dest, src) -> do
42 return $ set dest (get src s) s
43 ('+', dest, src) -> do
44 return $ set dest (get dest s + get src s) s
45 ('-', dest, src) -> do
46 return $ set dest (get dest s - get src s) s
47 (':', dest, src) ->
48 case get src s of
49 0 -> do return s
50 _ -> do return $ State a b (get dest s) p
51 return $ advance s'
52
53 run :: State -> IO State
54 run s = do
55 s'@(State _ _ i p) <- step s
56 let size = fromIntegral $ length p
57 if i >= size then return s' else run s'
58
59 parse string =
60 State 0 0 0 $ map (fromIntegral . Char.ord) string
61
62 runString string = run $ parse string
63
+57
-0
haskell/SKI.hs less more
0 -- Evaluator for Combinatory Logic (SKI-calculus)
1 -- I am not entirely convinced that it is correct
2
3 data Term = S
4 | K
5 | I
6 | Pair Term Term
7 deriving (Ord, Show, Eq)
8
9
10 step S = S
11 step K = K
12 step I = I
13 step (Pair I x) = x
14 step (Pair (Pair K x) y) = x
15 step (Pair (Pair (Pair S x) y) z) = (Pair (Pair x z) (Pair y z))
16 step (Pair l r) = (Pair (eval l) (eval r))
17
18 eval term =
19 let
20 term' = step term
21 in
22 if term == term' then
23 term
24 else
25 eval term'
26
27 parseChar 'S' = S
28 parseChar 'K' = K
29 parseChar 'I' = I
30
31 kParse (' ':rest) =
32 kParse rest
33 kParse ('(':rest) =
34 let
35 (t, rest') = kParse rest
36 in
37 bParse rest' t
38 kParse (char:rest) =
39 bParse rest (parseChar char)
40
41 bParse [] acc =
42 (acc, [])
43 bParse (' ':rest) acc =
44 bParse rest acc
45 bParse (')':rest) acc =
46 (acc, rest)
47 bParse ('(':rest) acc =
48 let
49 (t, rest') = kParse rest
50 in
51 bParse rest' (Pair acc t)
52 bParse (char:rest) acc =
53 bParse rest $ Pair acc (parseChar char)
54
55
56 run x = eval $ fst $ kParse x