#! /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)