blob: a462afe4c1d8b09ccb13ecdb19f67edff76dc97e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#! /usr/bin/env nix-shell
#! nix-shell -p haskellPackages.ghc -i runghc
{-# OPTIONS_GHC -Wall #-}
-- An expression in the SKI calculus is either S, K, I, or an application Ap of
-- any of 2 those combinators together.
data Expr
= S
| K
| I
| Ap Expr Expr
deriving (Show, Eq)
-- The eval function is the only function we need. It takes an expression and
-- returns an expresison.
eval :: Expr -> Expr
-- First define the S combinator. We evaluate in a strict fashion, from the left
-- to the right, so the placement of the parens must reflect this order of
-- operations.
eval S = S
eval (Ap (Ap (Ap S x) y) z) = eval (Ap (Ap x z) (Ap y z))
eval (Ap S x) = Ap S (eval x)
-- K and I combinators are simpler:
eval K = K
eval (Ap (Ap K x) _) = eval x
eval (Ap K x) = Ap K (eval x)
eval I = I
eval (Ap I x) = eval x
-- One benefit of doing this in Haskell is the compiler can do exaustive pattern
-- checking for us to make sure that we've covered every combination of S, K,
-- and I possible in our little language defined by 'Expr'.
--
-- In this case, the compiler warns that we don't have a case for
--
-- (Ap (Ap _ _) _)
--
-- so we just define that by recursing onto each branch of the Expr tree. But
-- first we check for equality, to avoid infinite recursion:
eval (Ap a b) =
if a == a' && b == b'
then (Ap a b)
else eval (Ap a' b')
where
a' = eval a
b' = eval b
-- Some example tests:
main :: IO ()
main = do
putStrLn $ "Expect I: " ++ show i
putStrLn $ "Expect K: " ++ show k
putStrLn $ "Expect K: " ++ show s
putStrLn $ "Expect S: " ++ show kiss
putStrLn $ "Expect SKSISKKI: " ++ show a
where
i = eval (Ap I I) -- I I = I
k = eval (Ap (Ap K K) I) -- K K I = K
s = eval (Ap (Ap (Ap S K) S) K) -- S K S K = K K (S K) = K
-- (S (K (S I)) (S (K K) I))
a = eval (Ap (Ap S (Ap K (Ap S I))) (Ap (Ap S (Ap K K)) I))
kiss = eval (Ap (Ap (Ap K I) S) S)
|
